#
# Classifier for old-style Sendmail messages
#
package Mail::Bounce::Sendmail5;

use strict;

use vars qw(@ISA @patterns);

@ISA = qw(Mail::Bounce::Heuristic);

# Sendmail 5 style
$patterns[0] = << 'EoF';
   ----- Transcript of session follows -----
While talking to ${REMOTE_MTA-\S+}:
>>> RCPT To:<${-\S+}>
<<< ${REMOTE_ERROR-.*}
${CODE-\S+} <${RECIP-\S+}>... ${DIAGNOSTIC-.*}

   ----- Unsent message follows -----
EoF

# This sample came from a claimed 8.9.3 installation
# Apparently some people turn MIME errors off?

$patterns[1] = << 'EoF';
The original message was received at ${ARRIVAL-.*}
from ${-.+}

   ----- The following addresses had permanent fatal errors -----
${RECIP2-\S+}
    (expanded from: <${RECIP3-\S+}>)

   ----- Transcript of session follows -----
... while talking to ${REMOTE_MTA-\S+}:
>>> RCPT To:<${-\S+}>
<<< ${REMOTE_ERROR-.*}
${CODE-\S+} ${RECIP-\S+}... ${DIAGNOSTIC-.*}

   ----- Original message follows -----
EoF

# this came from mshgw.msh.de, who claims to be SMAP....it is
# also the first multipart encountered.
$patterns[2] = << 'EoF';
The original message was received at ${ARRIVAL-.*}
from ${-.+}

   ----- The following addresses had delivery problems -----
${RECIP2-\S+}  (${DIAG2-.*})

   ----- Transcript of session follows -----
... while talking to ${REMOTE_MTA-\S+}:
>>> RCPT To:<${-\S+}>
<<< ${REMOTE_ERROR-.*}
${CODE-\S+} ${RECIP-\S+}... ${DIAGNOSTIC-.*}

   ----- Original message follows -----
EoF

# This came from idefix.wu-wiena.ac.at, which claims to be 8.8.7,
# but not to have DSN support
$patterns[3] = << 'EoF';
The original message was received at ${ARRIVAL-.*}
from ${-.+}

   ----- The following addresses had permanent fatal errors -----
${RECIP2-\S+}

   ----- Transcript of session follows -----
${CODE-\S+} ${RECIP-\S+}... ${DIAGNOSTIC-.*}

   ----- Original message follows -----
EoF

# this comes from resu1.ulb.ac.be - 8.8.8
# same as patterns[0], but no "expanded from" coment
$patterns[4] = << 'EoF';
The original message was received at ${ARRIVAL-.*}
from ${-.+}

   ----- The following addresses had permanent fatal errors -----
${RECIP2-\S+}

   ----- Transcript of session follows -----
... while talking to ${REMOTE_MTA-\S+}:
>>> RCPT To:<${-\S+}>
<<< ${REMOTE_ERROR-.*}
${CODE-\S+} ${RECIP-\S+}... ${DIAGNOSTIC-.*}

   ----- Original message follows -----
EoF

# This comes from powergrid.electriciti.com - 8.8.5 
$patterns[5] = << 'EoF';
The original message was received at ${ARRIVAL-.*}
from ${-.+}

   ----- The following addresses had permanent fatal errors -----
${RECIP2-\S+}
    (expanded from: <${RECIP3-\S+}>)

   ----- Transcript of session follows -----
${CODE-\S+} ${RECIP-\S+}... ${DIAGNOSTIC-.*}

   ----- Original message follows -----
EoF

# Pattern from quercy.cegramat.fr (5.x/SMI-SVR4) - truly ancient
$patterns[6] = << 'EoF';
   ----- Transcript of session follows -----
${-(?s:.*)}
${CODE-\d\d\d} <${RECIP-\S+}>... ${DIAGNOSTIC-.*}
<<< DATA

   ----- Unsent message follows -----
EoF

# Pattern from cyclone.stortek.com (5.x/SMI-SVR4) - truly ancient
# as above, but error is last
$patterns[7] = << 'EoF';
   ----- Transcript of session follows -----
${-(?s:.*)}
Connected to ${REMOTE_MTA-\S+}:
${-(?s:.*)}
${CODE-\d\d\d} ${RECIP-\S+}... ${DIAGNOSTIC-.*}

   ----- Unsent message follows -----
EoF

# Pattern from cs.uit.no - a VERY broken setup, IMHO
# Multipart, with session transcript in first part, alone.
$patterns[8] = << 'EoF';

While connected to ${REMOTE_MTA-.*}:
>>> RCPT To:<${RECIP1-\S+}>
<<< ${-.*}
${CODE-\d\d\d} <${RECIP-\S+}>... ${DIAGNOSTIC-.*}

EoF

# this comes from mail.cern.ch
# genericified session stuff.
$patterns[9] = << 'EoF';
The original message was received at ${ARRIVAL-.*}
from ${-.+}

   ----- The following addresses had permanent fatal errors -----
${RECIP2-\S+}

   ----- Transcript of session follows -----
${JUNK-(?s:.*)}
${CODE-\S+} ${RECIP-\S+}... ${DIAGNOSTIC-.*}

   ----- Original message follows -----
EoF

# this comes from ulysses.noc.ntua.gr (8.9.3)
# genericified stuff in first section.
$patterns[9] = << 'EoF';
The original message was received at ${ARRIVAL-.*}
from ${-.+}

${JUNK-(?s:.*)}
   ----- The following addresses had permanent fatal errors -----
${RECIP2-\S+}

   ----- Transcript of session follows -----
${TRANSCRIPT-(?s:.*)}
${CODE-\S+} ${RECIP-\S+}... ${DIAGNOSTIC-.*}

   ----- Original message follows -----
EoF

# this comes from mcmail.cis.mcmaster.ca
# genericified stuff at the EXPANDED FROM position
$patterns[10] = << 'EoF';
The original message was received at ${ARRIVAL-.*}
from ${-.+}

   ----- The following addresses had permanent fatal errors -----
${RECIP2-\S+}
${JUNK-(?s:.*)}

   ----- Transcript of session follows -----
${TRANSCRIPT-(?s:.*)}
${CODE-\S+} ${RECIP-\S+}... ${DIAGNOSTIC-.*}

   ----- Original message follows -----
EoF

# this came from wa.cmis.csiro.au, who claims to be SMI-8.6/SMI-SVR4
$patterns[11] = << 'EoF';
The original message was received at ${ARRIVAL-.*}
from ${-.+}

   ----- The following addresses had delivery problems -----
${RECIP2-\S+}  (${DIAG2-.*})

   ----- Transcript of session follows -----
${CODE-\S+} ${RECIP-\S+}... ${DIAGNOSTIC-.*}

   ----- Original message follows -----
EoF

# ixl.u-bordeaux.fr (SMI-8.6/SMI-4.1)
$patterns[12] = << 'EoF';
The original message was received at ${ARRIVAL-.*}
from ${-.+}

   ----- The following addresses had delivery problems -----
${RECIP2-\S+}  (${DIAG2-.*})
${JUNK-(?s:.*)}

   ----- Transcript of session follows -----
... while talking to ${REMOTE_MTA-\S+}:
>>> RCPT To:<${-\S+}>
<<< ${REMOTE_ERROR-.*}
${CODE-\S+} ${RECIP-\S+}... ${DIAGNOSTIC-.*}

   ----- Original message follows -----
EoF


sub validate {
    my $self = shift;

    my $bodyhandle;
    if ($self->is_multipart()) {
	$bodyhandle = $self->parts(0)->bodyhandle;
    } else {
	$bodyhandle = $self->bodyhandle;
    }
    my $keywords = $self->patternmatch($bodyhandle->as_string, @patterns);
    return defined($keywords);
}

sub recipients {
    my $self = shift;

    my $bodyhandle;
    if ($self->is_multipart()) {
	$bodyhandle = $self->parts(0)->bodyhandle;
    } else {
	$bodyhandle = $self->bodyhandle;
    }
    my $keywords = $self->patternmatch($bodyhandle->as_string, @patterns);
    if (defined($keywords)) {
	if (wantarray()) {
	    my $res = new Mail::Bounce::Address;
	    $res->type("permfail");
	    $res->action("failed");
	    if ($$keywords{CODE} eq "550") {
		$res->status("5.1.1 (user unknown)");
	    } else {
		$res->status("5.0.0");
	    }
	    $res->diagnostic("Sendmail; ". $$keywords{CODE} . " " . $$keywords{DIAGNOSTIC});
	    $res->final_recipient($$keywords{RECIP});
	    return $res;
	} else {
	    return 1;
	}
    } else {
	die "Sendmail: Unmatched pattern in recipients()\n";
    }
}
1;




